*
* $Id$
*
* $Log: xsecn2.F,v $
* Revision 1.1.1.1  2002/06/16 15:18:43  hristov
* Separate distribution  of Geant3
*
* Revision 1.1.1.1  1999/05/18 15:55:21  fca
* AliRoot sources
*
* Revision 1.1.1.1  1995/10/24 10:22:00  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/04 23/02/95  14.46.01  by  S.Giani
*-- Author :
      SUBROUTINE XSECN2(ICOM,IREC,IUNIT,IGAMS,LGAM,ELTOL,INABS,LNAB,
     + ITHRMS,LTHRM,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,Q,LR,QLR,
     + BUF,IBUF,LIM,LAST,INEL)
C       THIS ROUTINE READS THE REMAINDER OF INPUT I/O UNIT(s),
C       SELECTS THE ELEMENTS NEEDED FOR THE CALCULATIONS,
C       AND STORES THE CROSS SECTION DATA IN CORE
#include "geant321/minput.inc"
#include "geant321/mconst.inc"
#include "geant321/mmicab.inc"
      CHARACTER*4 MARK
      DIMENSION BUF(*),IBUF(*),ICOM(*),IGAMS(*),LGAM(*),INABS(*),
     +LNAB(*),ITHRMS(*),LTHRM(*),AWR(*),IDICTS(NNR,NNUC),ELTOL(*),
     +LDICT(NNR,NNUC),Q(NQ,NNUC),NTX(*),NTS(*),IGCBS(NGR,NNUC),
     +LGCB(NGR,NNUC),IREC(*),LR(NQ,NNUC),QLR(NQ,NNUC)
      DIMENSION INEL(*),IUNIT(*)
C       ASSIGN THE DEFAULT VALUES
      LEN=0
C       INITIALIZE THE COUNTERS FOR THE LOOP
C       NISR EQUALS THE NUMBER OF ISOTOPES READ
C       IRECNO EQUALS THE NEXT RECORD NUMBER TO BE READ ON INPUT
C  I/O UNIT (NUNIT)
C       LAST EQUALS THE LAST CORE POSITION USED IN THE CALLING
CROUTINE (INPUT1)
C       LST EQUALS THE LAST POSITION USED IN THE BUF ARRAY
C   (I.E. (BUF(LST) = D(LAST)))
      NISR=0
      IRECNO=1
      LST=0
C       PRINT OUT THE CROSS SECTION DIRECTORY IF CALLED FOR
   10 CONTINUE
C       START LOOP TO READ IN THE DATA ON INPUT I/O UNIT
      DO 370 II=1,NI
         IR   = IREC(II)
         IF(NUNIT.NE.IUNIT(II)) IRECNO = 1
         NUNIT= IUNIT(II)
         IF(NUNIT.LE.0) THEN
           WRITE(IOUT,'(/,'' XSECN2 : Wrong unit number '',I10)') NUNIT
           GOTO 370
         ENDIF
         IF(NISR.GE.NNUC)GO TO 370
         IF(IR.EQ.0)GO TO 370
C       LOOP TO LOCATE THE I CONTROL BLOCK RECORD (IR=IREC(II))
CZ x-section endmark = 'ENDE'
CZ file endmark ='ENDF'
         MARK = '   '
   20    IF(MARK.EQ.'ENDE') IRECNO = IRECNO + 1
         IF(MARK.EQ.'ENDF') GOTO 50
         IF(IR.EQ.IRECNO) GOTO 30
         READ(NUNIT,'(A)') MARK
         GO TO 20
C       CHECK TO DETERMINE THE ISOTOPE NUMBER FOR THE RANDOM WALK
   30    DO 40 I=1,NNUC
            IF(ICOM(I).EQ.II)GO TO 60
   40    CONTINUE
   50    WRITE(IOUT,10000)II
10000 FORMAT('0',10X,'ERROR IN ROUTINE XSECN2, II=',I6,/)
         GO TO 390
C       READ I CONTROL BLOCK RECORD OFF INPUT I/O UNIT (NUNIT) FOR
C       THE ELEMENT CORRESPONDING TO IREC(II) AND ICOM(I)
   60    IJK=I
         READ(NUNIT,'(I10,4G13.7,1I10,/,6I10)') IBUF(LST+1),(BUF(LST+
     +   IK),IK=2,5),(IBUF(LST+IJ),IJ=6,12)
         NISR=NISR+1
C       ASSIGN VALUES TO ARRAYS NEEDED FOR THE RANDOM WALK
         ISO=IJK
         NEL=INEL(II)
         AWR(ISO)=BUF(LST+2)
CZ store accuracy of xs
         ELTOL(ISO) = BUF(LST+4)
         IFLAGU=IBUF(LST+6)
         LGAM(ISO)=IBUF(LST+7)
         NTX(ISO)=IBUF(LST+8)
         NTS(ISO)=IBUF(LST+9)
         LTHRM(ISO)=IBUF(LST+11)
         LNAB(ISO)=IBUF(LST+12)
C       READ IN THE ISOTOPE DICTIONARY (IDICT ARRAY)
C       FROM INPUT I/O UNIT (NUNIT)
         READ(NUNIT,'((8I10))')(LDICT(J,ISO),J=1,NNR)
   70    CONTINUE
C       READ IN ENDF/B FILE3 CROSS SECTION DATA
C       READ IN ENDF/B FILE4 ANGULAR DISTRIBUTION DATA
C       READ IN ENDF/B FILE5 SECONDARY ENERGY DISTRIBUTION DATA
         DO 190 I2=1,NNR
            LZ=LDICT(I2,ISO)
            IF(LZ.EQ.0)GO TO 190
            LEN=LIM-LAST
            IF(LEN.LT.LZ)GO TO 380
            IDICTS(I2,ISO)=LAST+1-LMOX2
CZ changed in order to read ASCII input file
C I2 < 67  -> x-section data
C I2 < 123 -> angular distribution
C I2 < 134 -> secondary energy distribution
C I2 = 134 ->
            IF(I2.LT.67) THEN
               READ(NUNIT,'((6G13.7))')(BUF(LST+I),I=1,LZ)
            ELSE IF(I2.LT.123) THEN
C ------------------- I2 = 67 -----------------------------
               READ(NUNIT,'((8I10))') (IBUF(LST+I),I=1,2), (IBUF(LST+
     +         J+2),J=1,2*IBUF(LST+1))
               K = 2*IBUF(LST+1) + 2 + 1
               DO 80 J=1,IBUF(LST+2)
                  READ(NUNIT,'(G13.7,I10,/,(6G13.7))') BUF(LST+K),
     +            IBUF(LST+K+1), (BUF(LST+IK+K+1),IK=1,IBUF(LST+K+1)*2)
                  K = K + 2 + IBUF(LST+K+1)*2
   80          CONTINUE
            ELSE IF(I2.LT.134) THEN
C-------------------- I2 = 123 ----------------------------
               READ(NUNIT,'(2I10,G13.7,2I10,/,(8I10))') (IBUF(LST+I),
     +         I=1,2),BUF(LST+3),(IBUF(LST+J),J=4,5), (IBUF(LST+K+5),K=
     +         1,2*IBUF(LST+4))
               ID = 2*IBUF(LST+4) + 5
               LF = IBUF(LST+2)
               NP2 = 2*IBUF(LST+5)
               READ(NUNIT,'((6G13.7))') (BUF(LST+ID+I),I=1,NP2)
               ID = ID + NP2
               KEND = 1
               IF(LF.EQ.5.OR.LF.EQ.11) KEND = 2
               DO 100 K=1,KEND
                  READ(NUNIT,'((8I10))') (IBUF(LST+ID+I),I=1,2)
                  NR2 = 2*IBUF(LST+ID+1)
                  NE = IBUF(LST+ID+2)
                  ID = ID + 2
                  READ(NUNIT,'((8I10))') (IBUF(LST+ID+I),I=1,NR2)
                  ID = ID + NR2
                  IEND = NE
                  IF(LF.EQ.5.OR.LF.EQ.11) IEND = 1
                  IF(LF.EQ.7.OR.LF.EQ.9) IEND = 1
                  DO 90 I=1,IEND
                     IF(LF.EQ.1) THEN
                        READ(NUNIT,'(G13.7,2I10)') BUF(LST+ID+1),
     +                  (IBUF(LST+ID+J),J=2,3)
                        NR2 = 2*IBUF(LST+ID+2)
                        NP2 = 2*IBUF(LST+ID+3)
                        ID = ID + 3
                        READ(NUNIT,'((8I10))') (IBUF(LST+ID+J),J=1,
     +                  NR2)
                        ID = ID + NR2
                     ELSE
                        NP2 = 2*NE
                     ENDIF
                     READ(NUNIT,'((6G13.7))') (BUF(LST+ID+J),J=1,NP2)
                     ID = ID + NP2
   90             CONTINUE
  100          CONTINUE
            ELSE
C ------------------ I2 = 134 --------------------------------------
               READ(NUNIT,'(I10)') IBUF(LST+1)
               LNU = IBUF(LST+1)
               IF(LNU.NE.2) THEN
                  READ(NUNIT,'(I10,/,(6G13.7))') IBUF(LST+2), (BUF(LST
     +            +I+2),I=1,IBUF(LST+2))
               ELSE
                  READ(NUNIT,'((8I10))') (IBUF(LST+I),I=2,3)
                  NR2 = IBUF(LST+2)*2
                  READ(NUNIT,'((8I10))') (IBUF(LST+3+J),J=1,NR2)
                  NP2 = IBUF(LST+3)*2
                  READ(NUNIT,'((6G13.7))') (BUF(LST+3+NR2+J),J=1,NP2)
               ENDIF
            ENDIF
CZ end of change
            IF(I2.GT.66)GO TO 120
  110       CONTINUE
            GO TO 180
  120       IF(I2.GT.122)GO TO 150
  130       CONTINUE
            CALL ANGCDF(BUF(LST+1),BUF(LST+1),LZ)
  140       CONTINUE
            GO TO 180
  150       IF(I2.GT.133)GO TO 170
  160       CONTINUE
            GO TO 180
  170       CONTINUE
  180       CONTINUE
            LAST=LAST+LZ
            LST=LST+LZ
  190    CONTINUE
C       READ IN THE AVERAGE PHOTON PRODUCTION ARRAY
         LZ=LGAM(ISO)
         IF(LZ.EQ.0)GO TO 210
         LEN=LIM-LAST
         IF(LEN.LT.LZ)GO TO 380
         IGAMS(ISO)=LAST+1-LMOX2
         READ(NUNIT,'((6G13.7))')(BUF(LST+I),I=1,LZ)
  200    CONTINUE
         LAST=LAST+LZ
         LST=LST+LZ
  210    CONTINUE
C       READ IN THE TOTAL NEUTRON DISAPPERANCE ARRAY
         LZ=LNAB(ISO)
         IF(LZ.EQ.0)GO TO 230
         LEN=LIM-LAST
         IF(LEN.LT.LZ)GO TO 380
         INABS(ISO)=LAST+1-LMOX2
         READ(NUNIT,'((6G13.7))')(BUF(LST+I),I=1,LZ)
  220    CONTINUE
         LAST=LAST+LZ
         LST=LST+LZ
  230    CONTINUE
C       READ IN THE Q VALUE ARRAY
         READ(NUNIT,'((6G13.7))')(Q(I,ISO),I=1,NQ)
  240    CONTINUE
C       READ IN THE LR VALUE ARRAY
         READ(NUNIT,'((8I10))')(LR(I,ISO),I=1,NQ)
  250    CONTINUE
C       READ IN THE QLR VALUE ARRAY
         READ(NUNIT,'((6G13.7))')(QLR(I,ISO),I=1,NQ)
  260    CONTINUE
C       READ IN THE PHOTON DATA DICTIONARY (GCB ARRAY)
C       FROM INPUT I/O UNIT (NUNIT)
C       CURRENT STORAGE IS SET TO ACCOMODATE UP TO 30 INTERACTIONS
C       (I.E. (2*NTX(ISO)+2*NTS(ISO)).LE.NGR)
         L=2*NTX(ISO)+2*NTS(ISO)
         IF(L.EQ.0)GO TO 350
         L1=2*NTX(ISO)
         L2=L1+1
         READ(NUNIT,'((8I10))')(LGCB(J,ISO),J=1,L)
  270    CONTINUE
C       READ IN ENDF/B FILE12 PHOTON MULTIPLICATION DATA
C       READ IN ENDF/B FILE13 PHOTON CROSS SECTION DATA
         NNTX=NTX(ISO)
         DO 300 I2=1,NNTX
            LZ=LGCB(2*I2,ISO)
            IF(LZ.EQ.0)GO TO 300
            LEN=LIM-LAST
            IF(LEN.LT.LZ)GO TO 380
            IGCBS(2*I2-1,ISO)=LGCB(2*I2-1,ISO)
            IGCBS(2*I2,ISO)=LAST+1-LMOX2
CZ changed in order to read ASCII xsection file
            READ(NUNIT,'((8I10))') (IBUF(LST+I),I=1,2)
            READ(NUNIT,'((6G13.7))') (BUF(LST+J+2),J=1,IBUF(LST+2))
            ID = IBUF(LST+2) + 2 + LST
            DO 280 K = 1, IBUF(LST+1)
               READ(NUNIT,'(2(G13.7,I10))') BUF(ID+1),IBUF(ID+2),
     +         BUF(ID+3),IBUF(ID+4)
               ID = ID + 4
               READ(NUNIT,'((6G13.7))') (BUF(ID + J),J=1,IBUF(LST+2))
               ID = ID + IBUF(LST+2)
  280       CONTINUE
CZ end of change
  290       CONTINUE
            LAST=LAST+LZ
            LST=LST+LZ
  300    CONTINUE
C       READ IN ENDF/B FILE15 PHOTON SECONDARY ENERGY DISTRIBUTIONS
         NNTS=NTS(ISO)
         IF(NNTS.EQ.0)GO TO 350
         DO 340 I2=1,NNTS
            LZ=LGCB(L1+2*I2,ISO)
            IF(LZ.EQ.0)GO TO 340
            LEN=LIM-LAST
            IF(LEN.LT.LZ)GO TO 380
            IGCBS(L1+2*I2-1,ISO)=LGCB(L1+2*I2-1,ISO)
            IGCBS(L1+2*I2,ISO)=LAST+1-LMOX2
CZ changed in order to read ASCII xsection file
            READ(NUNIT,'(2I10,G13.7,2I10,/,(8I10))') (IBUF(LST+I),I=1,
     +      2),BUF(LST+3), (IBUF(LST+J),J=4,5), (IBUF(LST+K+5),K=1,2*
     +      IBUF(LST+4))
            ID = 2*IBUF(LST+4) + 5
            LF = IBUF(LST+2)
            NP2 = 2*IBUF(LST+5)
            READ(NUNIT,'((6G13.7))') (BUF(LST+ID+I),I=1,NP2)
            ID = ID + NP2
            KEND = 1
            IF(LF.EQ.5.OR.LF.EQ.11) KEND = 2
            DO 320 K=1,KEND
               READ(NUNIT,'((8I10))') (IBUF(LST+ID+I),I=1,2)
               NR2 = 2*IBUF(LST+ID+1)
               NE = IBUF(LST+ID+2)
               ID = ID + 2
               READ(NUNIT,'((8I10))') (IBUF(LST+ID+I),I=1,NR2)
               ID = ID + NR2
               IEND = NE
               IF(LF.EQ.5.OR.LF.EQ.11) IEND = 1
               IF(LF.EQ.7.OR.LF.EQ.9) IEND = 1
               DO 310 I=1,IEND
                  IF(LF.EQ.1) THEN
                     READ(NUNIT,'(G13.7,2I10)') BUF(LST+ID+1), (IBUF(L
     +               ST+ID+J),J=2,3)
                     NR2 = 2*IBUF(LST+ID+2)
                     NP2 = 2*IBUF(LST+ID+3)
                     ID = ID + 3
                     READ(NUNIT,'((8I10))') (IBUF(LST+ID+J),J=1,NR2)
                     ID = ID + NR2
                  ELSE
                     NP2 = 2*NE
                  ENDIF
                  READ(NUNIT,'((6G13.7))') (BUF(LST+ID+J),J=1,NP2)
                  ID = ID + NP2
  310          CONTINUE
  320       CONTINUE
CZ end of change
  330       CONTINUE
            LAST=LAST+LZ
            LST=LST+LZ
  340    CONTINUE
  350    CONTINUE
C       READ IN THE THERMAL CROSS SECTION DATA ARRAY
         LZ=LTHRM(ISO)
         IF(LZ.EQ.0)GO TO 360
         LEN=LIM-LAST
         IF(LEN.LT.LZ)GO TO 380
         ITHRMS(ISO)=LAST+1
         READ(NUNIT,'((6G13.7))')(BUF(LST+I),I=1,LZ)
         LAST=LAST+LZ
         LST=LST+LZ
  360    CONTINUE
  370 CONTINUE
      GO TO 400
  380 WRITE(IOUT,10100)LZ,LEN
10100 FORMAT('0','NOT ENOUGH SPACE TO READ IN RECORD',/,5X,
     +'LENGTH OF RECORD=',I10,/,5X,'SPACE AVAILABLE=',I10)
  390 PRINT '('' CALOR: ERROR in XSECN2 ====> STOP '')'
      STOP
  400 RETURN
      END
